home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / finger-1 / my_units / myutils.uni < prev    next >
Text File  |  1992-02-24  |  10KB  |  456 lines
  1. unit MyUtils;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6. { This is part of my generic library of routines }
  7.  
  8. interface
  9.  
  10.     type
  11.         versionRecord = packed record
  12.                 version: integer;
  13.                 devcode: byte;
  14.                 revision: byte;
  15.                 country: integer;
  16.                 short: str15;
  17.                 long: str255;
  18.             end;
  19.  
  20.     function TrapAvailable (tNumber: INTEGER): BOOLEAN;
  21.     function MyNumToString (n: longInt): str255;
  22.     function NumToStr (n: longInt): str255;
  23.     function StrToNum (s: str255): longInt;
  24.     function GetIndexedString (strh, i: integer): str255;
  25.     procedure DotDotDot (var s: str255; var width: integer);
  26.     procedure SetItemEnable (mh: menuHandle; item: integer; enable: boolean);
  27.     procedure SetIDItemEnable (menu, item: integer; enable: boolean);
  28.     function GetIDItemEnable (menu, item: integer): boolean;
  29.     function GetItemEnable (mh: menuHandle; item: integer): boolean;
  30.     procedure DotItem (mh: menuHandle; item: integer; dotted: boolean);
  31.     function MyFrontWindow: boolean;
  32.     function DAFrontWindow: boolean;
  33.     function GetIndStrSize (size, id, index: integer): str255;
  34.     procedure GetVersion (var vers: versionRecord);
  35.     procedure SetVersionParamText (c2, c3: str255);
  36.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  37.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  38.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  39.     procedure HiliteItem (dlg: dialogPtr; item: integer; on: boolean);
  40.     function ControlEnabled (dlg: dialogPtr; item: integer): boolean;
  41.     function GetVolInfo (var name: str63; var vrn: integer; index: integer; var CrDate: longInt): OSErr;
  42.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  43.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  44.     procedure FlashItem (dlg: dialogPtr; item: integer);
  45.     procedure PlotSICN (id: integer; index, v, h: integer);
  46.     procedure SegmentInit;
  47.     procedure SegmentUtil;
  48.     procedure SegmentUtil2;
  49.     procedure SegmentTerm;
  50.     function HLockState (h: univ handle): signedByte;
  51. {    procedure SPrintS5V (var dst: str255;var  src,s1, s2, s3, s4, s5: str255);}
  52.     procedure SPrintS5 (var dst: str255; src, s1, s2, s3, s4, s5: str255);
  53.  
  54. implementation
  55.  
  56.     uses
  57.         MyTypes, Traps;
  58.  
  59. {$S Init}
  60.     procedure SegmentInit;
  61.     begin
  62.     end;
  63.  
  64. {$S Util}
  65.     procedure SegmentUtil;
  66.     begin
  67.     end;
  68.  
  69. {$S Util2}
  70.     procedure SegmentUtil2;
  71.     begin
  72.     end;
  73.  
  74. {$S Term}
  75.     procedure SegmentTerm;
  76.     begin
  77.     end;
  78.  
  79. {$S Util}
  80.     function TrapAvailable (tNumber: INTEGER): BOOLEAN;
  81. {Check to see if a given trap is implemented. Babble as taken from IM6 }
  82.         const
  83.             TrapMask = $0800;
  84.         var
  85.             tType: TrapType;
  86.             ignoreError: OSErr;
  87.     begin
  88.         if BAND(tNumber, TrapMask) > 0 then
  89.             tType := ToolTrap
  90.         else
  91.             tType := OSTrap;
  92.         if tType = ToolTrap then begin
  93.             tNumber := BAND(tNumber, $7FF);
  94.             if tNumber >= $400 then
  95.                 tNumber := _Unimplemented
  96.             else if tNumber >= $200 then
  97.                 if NGetTrapAddress($A86E, ToolTrap) <> NGetTrapAddress($AA6E, ToolTrap) then
  98.                     tNumber := _Unimplemented;
  99.         end;
  100.         TrapAvailable := NGetTrapAddress(tNumber, tType) <> GetTrapAddress(_Unimplemented);
  101.     end; {TrapAvailable}
  102.  
  103. {$S Util}
  104.     function MyNumToString (n: longInt): str255;
  105.         var
  106.             s: str255;
  107.     begin
  108.         if abs(n) < 4096 then
  109.             NumToString(n, s)
  110.         else if abs(n) < 4194304 then begin
  111.             NumToString(n div 1024, s);
  112.             s := Concat(s, 'k');
  113.         end
  114.         else begin
  115.             NumToString(n div 1048576, s);
  116.             s := Concat(s, 'M');
  117.         end;
  118.         MyNumToString := s;
  119.     end;
  120.  
  121. {$S Util}
  122.     function NumToStr (n: longInt): str255;
  123.         var
  124.             s: str255;
  125.     begin
  126.         NumToString(n, s);
  127.         NumToStr := s;
  128.     end;
  129.  
  130. {$S Util}
  131.     function StrToNum (s: str255): longInt;
  132.         var
  133.             n: longInt;
  134.     begin
  135.         StringToNum(s, n);
  136.         StrToNum := n;
  137.     end;
  138.  
  139. {$S Util}
  140.     function GetIndexedString (strh, i: integer): str255;
  141.         var
  142.             s: str255;
  143.     begin
  144.         GetIndString(s, strh, i);
  145.         GetIndexedString := s;
  146.     end;
  147.  
  148. {$S Util2}
  149.     procedure DotDotDot (var s: str255; var width: integer);
  150.         var
  151.             maxwidth, len: integer;
  152.     begin
  153.         maxwidth := width;
  154.         width := StringWidth(s);
  155.         if width > maxwidth then begin
  156.             width := width + CharWidth('╔');
  157. {$PUSH}
  158. {$R-}
  159.             len := ord(s[0]);
  160.             while (len > 0) and (width > maxwidth) do begin
  161.                 width := width - CharWidth(s[len]);
  162.                 len := len - 1;
  163.             end;
  164.             len := len + 1;
  165.             s[0] := chr(len);
  166.             s[len] := '╔';
  167. {$POP}
  168.         end;
  169.     end;
  170.  
  171. {$S}
  172.     procedure SetItemEnable (mh: menuHandle; item: integer; enable: boolean);
  173.     begin
  174.         if enable then
  175.             EnableItem(mh, item)
  176.         else
  177.             DisableItem(mh, item);
  178.     end;
  179.  
  180. {$S}
  181.     procedure SetIDItemEnable (menu, item: integer; enable: boolean);
  182.     begin
  183.         SetItemEnable(GetMHandle(menu), item, enable);
  184.     end;
  185.  
  186. {$S}
  187.     function GetItemEnable (mh: menuHandle; item: integer): boolean;
  188.     begin
  189.         if item > 31 then
  190.             GetItemEnable := true
  191.         else
  192.             GetItemEnable := BTST(mh^^.enableFlags, item);
  193.     end;
  194.  
  195. {$S}
  196.     function GetIDItemEnable (menu, item: integer): boolean;
  197.     begin
  198.         GetIDItemEnable := GetItemEnable(GetMHandle(menu), item);
  199.     end;
  200.  
  201. {$S Util2}
  202.     procedure DotItem (mh: menuHandle; item: integer; dotted: boolean);
  203.     begin
  204.         if dotted then
  205.             SetItemMark(mh, item, 'Ñ')
  206.         else
  207.             SetItemMark(mh, item, chr(0));
  208.     end;
  209.  
  210. {$S Util2}
  211.     function MyFrontWindow: boolean;
  212.         var
  213.             wp: windowPtr;
  214.     begin
  215.         wp := FrontWindow;
  216.         if wp = nil then
  217.             MyFrontWindow := false
  218.         else
  219.             MyFrontWindow := windowPeek(wp)^.windowKind >= userKind;
  220.     end;
  221.  
  222. {$S Util2}
  223.     function DAFrontWindow: boolean;
  224.         var
  225.             wp: windowPtr;
  226.     begin
  227.         wp := FrontWindow;
  228.         if wp = nil then
  229.             DAFrontWindow := false
  230.         else
  231.             DAFrontWindow := windowPeek(wp)^.windowKind < 0;
  232.     end;
  233.  
  234. {$S Util2}
  235.     function GetIndStrSize (size, id, index: integer): str255;
  236.         var
  237.             s255: str255;
  238.     begin
  239.         GetIndString(s255, id, index);
  240.         GetIndStrSize := copy(s255, 1, size - 1);
  241.     end;
  242.  
  243. {$S Util}
  244.     procedure GetVersion (var vers: versionRecord);
  245.         var
  246.             vh: handle;
  247.     begin
  248.         with vers do begin
  249.             vh := GetResource('vers', 1);
  250.             if vh = nil then begin
  251.                 version := $0000;
  252.                 devcode := $20;
  253.                 revision := $00;
  254.                 country := 0;
  255.                 short := '0.0.0';
  256.                 long := 'Unknown v0.0.0';
  257.             end
  258.             else begin
  259.                 BlockMove(vh^, @vers, sizeof(vers));
  260. {$PUSH}
  261.  {$R-}
  262.                 BlockMove(Ptr(longint(vh^) + (longint(@short) - longint(@vers)) + ord(short[0]) + 1), @long, sizeof(long));
  263.                 if ord(short[0]) >= sizeof(short) then
  264.                     short[0] := chr(sizeof(short) - 1);
  265. {$POP}
  266.                 ReleaseResource(vh);
  267.             end;
  268.         end;
  269.     end;
  270.  
  271. {$S Util}
  272.     procedure SetVersionParamText (c2, c3: str255);
  273.         var
  274.             vers: versionRecord;
  275.     begin
  276.         GetVersion(vers);
  277.         ParamText(vers.short, vers.long, c2, c3);
  278.     end;
  279.  
  280. {$S Util}
  281.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  282.         var
  283.             procID: longInt;
  284.             oe: OSErr;
  285.     begin
  286.         oe := GetWDInfo(wdrn, vrn, dirID, procID);
  287.         if oe <> noErr then begin
  288.             vrn := wdrn;
  289.             dirID := 0;
  290.         end;
  291.         GetDirID := oe;
  292.     end;
  293.  
  294. {$S Util}
  295.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  296.         var
  297.             it: integer;
  298.             ih: handle;
  299.             box: rect;
  300.             oldtext: str255;
  301.     begin
  302.         GetDItem(dlg, item, it, ih, box);
  303.         GetIText(ih, oldtext);
  304.         if oldtext <> text then
  305.             SetIText(ih, text);
  306.     end;
  307.  
  308. {$S Util}
  309.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  310.         var
  311.             it: integer;
  312.             ih: handle;
  313.             box: rect;
  314.             oldtext: str255;
  315.     begin
  316.         GetDItem(dlg, item, it, ih, box);
  317.         GetIText(ih, text);
  318.     end;
  319.  
  320. {$S Util}
  321.     procedure HiliteItem (dlg: dialogPtr; item: integer; on: boolean);
  322.         var
  323.             k: integer;
  324.             h: handle;
  325.             r: rect;
  326.     begin
  327.         GetDItem(dlg, item, k, h, r);
  328.         HiliteControl(controlHandle(h), 255 * ord(not on));
  329.     end;
  330.  
  331. {$S Util}
  332.     function ControlEnabled (dlg: dialogPtr; item: integer): boolean;
  333.         var
  334.             k: integer;
  335.             h: handle;
  336.             r: rect;
  337.     begin
  338.         GetDItem(dlg, item, k, h, r);
  339.         ControlEnabled := controlHandle(h)^^.contrlHilite <> 255;
  340.     end;
  341.  
  342. {$S Util2}
  343.     function GetVolInfo (var name: str63; var vrn: integer; index: integer; var CrDate: longInt): OSErr;
  344.         var
  345.             pb: paramBlockRec;
  346.             oe: OSErr;
  347.     begin
  348.         with pb do begin
  349.             if (name <> '') & (name[length(name)] <> ':') then
  350.                 name := concat(name, ':');
  351.             pb.ioNamePtr := @name;
  352.             ioVRefNum := vrn;
  353.             ioVolIndex := index;
  354.             oe := PBGetVInfo(@pb, false);
  355.             if oe = noErr then begin
  356.                 vrn := ioVRefNum;
  357.                 CrDate := ioVCrDate;
  358.             end;
  359.         end;
  360.         GetVolInfo := oe;
  361.     end;
  362.  
  363. {$S}
  364.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  365.         var
  366.             kind: integer;
  367.             h: handle;
  368.             r: rect;
  369.     begin
  370.         GetDItem(dp, 1, kind, h, r);
  371.         PenSize(3, 3);
  372.         InsetRect(r, -4, -4);
  373.         FrameRoundRect(r, 16, 16);
  374.     end;
  375.  
  376. {$S Util}
  377.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  378.         var
  379.             kind: integer;
  380.             h: handle;
  381.             r: rect;
  382.     begin
  383.         if def_item <> 1 then
  384.             DebugStr('MyUtilities:SetUpDefaultOutline:Cant handle anything except 1 yet');
  385.         GetDItem(dp, user_item, kind, h, r);
  386.         InsetRect(r, -10, -10);
  387.         SetDItem(dp, user_item, userItem, handle(@OutlineDefault1), r);
  388.     end;
  389.  
  390. {$S Util}
  391.     procedure FlashItem (dlg: dialogPtr; item: integer);
  392.         var
  393.             kind: integer;
  394.             h: handle;
  395.             r: rect;
  396.             f: longInt;
  397.     begin
  398.         GetDItem(dlg, item, kind, h, r);
  399.         HiliteControl(controlHandle(h), 1);
  400.         Delay(2, f);
  401.         HiliteControl(controlHandle(h), 0);
  402.     end;
  403.  
  404. {$S Util}
  405.     procedure PlotSICN (id: integer; index, v, h: integer);
  406.         var
  407.             sh: Handle;
  408.             bm: BitMap;
  409.             r: Rect;
  410.             gp: grafptr;
  411.     begin
  412.         sh := GetResource('SICN', id);
  413.         HLock(sh);
  414.         bm.baseAddr := Ptr(longInt(sh^) + (index - 1) * 32);
  415.         bm.rowBytes := 2;
  416.         SetRect(r, h, v, h + 16, v + 16);
  417.         bm.bounds := r;
  418.         GetPort(gp);
  419.         CopyBits(bm, gp^.portBits, r, r, srcCopy, nil);
  420.         HUnlock(sh);
  421.     end;
  422.  
  423.     function HLockState (h: univ handle): signedByte;
  424.     begin
  425.         HLockState := HGetState(h);
  426.         HLock(h);
  427.     end;
  428.  
  429. {$Z+}
  430.     procedure SPrintS5V (var dst: str255; var src, s1, s2, s3, s4, s5: str255);
  431.         procedure DoSub (n: integer; var s: str255);
  432.             var
  433.                 p: integer;
  434.         begin
  435.             p := Pos(concat('^', chr(n + 48)), dst);
  436.             if p > 0 then begin
  437.                 Delete(dst, p, 2);
  438.                 Insert(s, dst, p);
  439.             end;
  440.         end;
  441.     begin
  442.         dst := src;
  443.         DoSub(5, s5);
  444.         DoSub(4, s4);
  445.         DoSub(3, s3);
  446.         DoSub(2, s2);
  447.         DoSub(1, s1);
  448.     end;
  449. {$Z-}
  450.  
  451.     procedure SPrintS5 (var dst: str255; src, s1, s2, s3, s4, s5: str255);
  452.     begin
  453.         SPrintS5V(dst, src, s1, s2, s3, s4, s5);
  454.     end;
  455.  
  456. end.